home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / Pascal / Snippets / PNL Libraries / MySimpleProfile.p < prev    next >
Encoding:
Text File  |  1996-11-09  |  2.4 KB  |  112 lines  |  [TEXT/CWIE]
  1. unit MySimpleProfile;
  2.  
  3. interface
  4.  
  5.     uses
  6.         Types;
  7.     
  8.     procedure StartupSimpleProfile;
  9.     procedure MarkProfile(mark:Str15);
  10.     
  11. implementation
  12.  
  13.     uses
  14.         Files,Timer,ToolUtils, TextUtils, Memory, 
  15.         MyMemory, MyStartup;
  16.     
  17.     const
  18.         max_profile_marks = 10000;
  19.     
  20.     type
  21.         MarkString = string[9];
  22.     
  23.     type
  24.         ProfileMark=record
  25.             time:longint;
  26.             mark:MarkString;
  27.         end;
  28.         ProfileMarksArray=array[1..max_profile_marks] of ProfileMark;
  29.         ProfileMarksArrayPtr=^ProfileMarksArray;
  30.         
  31.     var
  32.         start_time: UnsignedWide;
  33.         profile_mark:longint;
  34.         profile_marks:ProfileMarksArrayPtr;
  35.     
  36.     procedure MarkProfile(mark:Str15);
  37.         var
  38.             current_time: UnsignedWide;
  39.     begin
  40.         if (profile_marks<>nil) & (profile_mark<max_profile_marks) then begin
  41.             Microseconds(current_time);
  42.             Inc(profile_mark);
  43.             profile_marks^[profile_mark].mark := mark;
  44.             profile_marks^[profile_mark].time := current_time.lo - start_time.lo;
  45.         end;
  46.     end;
  47.     
  48.     function InitSimpleProfile(var msg: integer): OSStatus;
  49.     begin
  50. {$unused(msg)}
  51.         profile_mark := 0;
  52.         InitSimpleProfile := MNewPtr(profile_marks, SizeOf(ProfileMarksArray));
  53.     end;
  54.     
  55.     procedure FinishSimpleProfile;
  56.         var
  57.             rn:integer;
  58.             data: Handle;
  59.         procedure FlushHandle;
  60.             var
  61.                 err: OSErr;
  62.                 count: longint;
  63.         begin
  64.             count := GetHandleSize( data );
  65.             HLock( data );
  66.             err := FSWrite(rn, count, data^);
  67.             HUnlock( data );
  68.             SetHandleSize( data, 0 );
  69.         end;
  70.         var
  71.             fs:FSSpec;
  72.             junk,err:OSErr;
  73.             i:longint;
  74.             s,t:Str255;
  75.             lasttime,thistime:longint;
  76.     begin
  77.         junk:=FSMakeFSSpec(-1,2,'Profile Dump',fs);
  78.         junk:=FSpDelete(fs);
  79.         if profile_mark > 0 then begin
  80.             err := FSpCreate(fs,'R*ch','TEXT',0);
  81.             err := FSpOpenDF(fs,fsRdWrPerm,rn);
  82.             if err=noErr then begin
  83.                 data := NewHandle( 0 );
  84.                 lasttime := profile_marks^[1].time;
  85.                 for i := 1 to profile_mark do begin
  86.                     s := profile_marks^[i].mark;
  87.                     thistime := profile_marks^[i].time;
  88.                     NumToString(thistime,t);
  89.                     s := concat(s, chr(9), t);
  90.                     NumToString(thistime-lasttime,t);
  91.                     s := concat(s, chr(9), t);
  92.                     lasttime := thistime;
  93.                     s := concat(s, chr(13));
  94.                     err := PtrAndHand( @s[1], data, length(s) );
  95.                     if GetHandleSize( data ) > 8192 then begin
  96.                         FlushHandle;
  97.                     end;
  98.                 end;
  99.                 FlushHandle;
  100.                 junk := FSClose(rn);
  101.             end;
  102.         end;
  103.         MDisposePtr(profile_marks);
  104.     end;
  105.     
  106.     procedure StartupSimpleProfile;
  107.     begin
  108.         SetStartup(InitSimpleProfile, nil, 0, FinishSimpleProfile);
  109.     end;
  110.     
  111. end.
  112.